﻿'Option Explicit On
'Option Strict On

Imports System.Windows.Forms

Public Class ExportToExcels
    Public Shared Function ExportListViewToExcel(ByVal MyListView As Windows.Forms.ListView) As Boolean

        '========================================================================= 

        '== This is our Exvel Class == 

        '== Remember to add a refrence to Microsoft Excel XX.XX Object Libary == 

        '========================================================================= 

        : Dim ExcelReport As Excel.ApplicationClass

        '====================================================================================

        '== TMAX_COLOURS is the masimum amount of colours excel will let us save in the palet 

        '===================================================================================

        Const MAX_COLOURS As Int16 = 40

        '======================================================================= 

        '== Excel will only allow 25 colums per sheet (starting at 0 = 254) == 

        '======================================================================= 

        Const MAX_COLUMS As Int16 = 254

        '===================================================== 

        '== Simple counter to count itesm in our listview == 

        '===================================================== 

        Dim i As Integer

        Dim New_Item As Windows.Forms.ListViewItem

        '========================================================== 

        '== The Colum Letter(and number) we are on and the row == 

        '========================================================== 

        Dim TempColum As Int16

        Dim ColumLetter As String

        Dim TempRow As Int16

        Dim TempColum2 As Int16

        '============================================= 

        '== Colours we have added to Excels palet == 

        '============================================= 

        Dim AddedColours As Int16 = 1

        Dim MyColours As Hashtable = New Hashtable

        '=========================================================================== 

        '== Variables to control if we need to add a new colour to Excels palet == 

        '=========================================================================== 

        Dim AddNewBackColour As Boolean = True

        Dim AddNewFrontColour As Boolean = True

        Dim BackColour As String

        Dim FrontColour As String

        '============================================================ 

        '== Setup our Excel Class and open a new workbook to use == 

        '============================================================ 

        ExcelReport = New Excel.ApplicationClass

        '-- Setting this to false and then resetting it to true at the end will stop 

        '-- a user clicking around in excel and causing a possible error 

        ExcelReport.Visible = True

        ExcelReport.Workbooks.Add()

        ExcelReport.Worksheets("Sheet1").Select()

        ExcelReport.Sheets("Sheet1").Name = MyListView.Name

        '======================================================= 

        '== Add all the colums from the listview into Excel == 

        '======================================================= 

        i = 0

        Do Until i = MyListView.Columns.Count

            '========================================================================== 

            '== Work out which colum we are on == 

            '== The Colums Go from A-Z and to IV, so A-Z to AA-AZ to BA-BZ etc etc == 

            '========================================================================== 

            If i > MAX_COLUMS Then

                MsgBox("Too many Colums added")

                Exit Do

            End If

            TempColum = i

            TempColum2 = 0

            Do While TempColum > 25

                TempColum -= 26

                TempColum2 += 1

            Loop

            ColumLetter = Chr(97 + TempColum)

            If TempColum2 > 0 Then ColumLetter = Chr(96 + TempColum2) & ColumLetter

            '======================================================= 

            '== Add all the colums from the listview into Excel == 

            '======================================================= 

            ExcelReport.Range(ColumLetter & 1).Value = MyListView.Columns(i).Text

            ExcelReport.Range(ColumLetter & 1).Font.Name = MyListView.Font.Name

            ExcelReport.Range(ColumLetter & 1).Font.Size = MyListView.Font.Size

            i += 1

        Loop

        '================================================================================== 

        '== Move to the second row in Excel and get all the items out of the list view == 

        '================================================================================== 

        TempRow = 2

        For Each New_Item In MyListView.Items

            i = 0

            Do Until i = New_Item.SubItems.Count

                '========================================================================== 

                '== Work out which colum we are on == 

                '== The Colums Go from A-Z and to IV, so A-Z to AA-AZ to BA-BZ etc etc == 

                '========================================================================== 

                If i > MAX_COLUMS Then

                    MsgBox("Too many Colums added")

                    Exit Do

                End If

                TempColum = i

                TempColum2 = 0

                Do While TempColum > 25

                    TempColum -= 26

                    TempColum2 += 1

                Loop

                ColumLetter = Chr(97 + TempColum)

                If TempColum2 > 0 Then ColumLetter = Chr(96 + TempColum2) & ColumLetter

                '=========================================================================== 

                '== Add all the List View colums into Excel == 

                '== We also get the List Views font type and size and set it to the row == 

                '=========================================================================== 

                ExcelReport.Range(ColumLetter & TempRow).Value = New_Item.SubItems(i).Text

                ExcelReport.Range(ColumLetter & TempRow).Font.Name = New_Item.Font.Name

                ExcelReport.Range(ColumLetter & TempRow).Font.Size = New_Item.Font.Size

                '============================================================ 

                '== Reset the check to see if we have found a new colour == 

                '============================================================ 

                AddNewFrontColour = False

                AddNewBackColour = False

                Try

                    '=================================================================== 

                    '== Check our Colours Hashtable for a colour with the same name == 

                    '== as the backcolour of our listview item == 

                    '=================================================================== 

                    BackColour = MyColours(New_Item.BackColor.ToString)

                    If BackColour = "" Then AddNewBackColour = True

                    '=================================================================== 

                    '== Check our Colours Hashtable for a colour with the same name == 

                    '== as the Text colour of our listview item == 

                    '=================================================================== 

                    FrontColour = MyColours(New_Item.ForeColor.ToString)

                    If FrontColour = "" Then AddNewFrontColour = True

                Catch ex As Exception

                    AddNewFrontColour = False

                    AddNewBackColour = False

                End Try

                '========================================================================= 

                '== If there is room for new colours and we have found some, add them == 

                '== to Excels palet == 

                '========================================================================= 

                If AddedColours < MAX_COLOURS And (AddNewFrontColour Or AddNewBackColour) And (New_Item.BackColor.ToArgb <> -1) Then

                    If AddNewBackColour Then

                        MyColours.Add(New_Item.BackColor.ToString, AddedColours)

                        ExcelReport.Workbooks.Item(1).Colors(AddedColours) = RGB(New_Item.BackColor.R, New_Item.BackColor.G, New_Item.BackColor.B)

                        AddedColours += 1

                    End If

                    If AddNewFrontColour Then

                        MyColours.Add(New_Item.ForeColor.ToString, AddedColours)

                        ExcelReport.Workbooks.Item(1).Colors(AddedColours) = RGB(New_Item.ForeColor.R, New_Item.ForeColor.G, New_Item.ForeColor.B)

                        AddedColours += 1

                    End If

                End If

                '======================================================================== 

                '== Now all we need to do it select the rown and set the two colours == 

                '== Interior is back backgrounf and Font is the font colour == 

                '======================================================================== 

                ExcelReport.Rows(TempRow & ":" & TempRow).select()

                ExcelReport.Selection.Interior.ColorIndex = MyColours(New_Item.BackColor.ToString)

                ExcelReport.Selection.Font.ColorIndex = MyColours(New_Item.ForeColor.ToString)

                i += 1

            Loop

            TempRow += 1

        Next

        '======================================================================= 

        '== Now all thats left to do is select all the colums and rows == 

        '== Resize them to so they are all the right widths to see the data == 

        '== and finaly select from A1 so the user is taken to the start == 

        '======================================================================= 

        ExcelReport.Cells.Select()

        ExcelReport.Cells.EntireColumn.AutoFit()

        ExcelReport.Cells.Range("A1").Select()

    End Function
End Class
